home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / vector.cls < prev    next >
Text File  |  1997-06-14  |  3KB  |  128 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "CVector"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = True
  10. Option Explicit
  11.  
  12. Public Enum EErrorVector
  13.     eeBaseVector = 13270    ' CVector
  14. End Enum
  15.  
  16. Private av() As Variant
  17. Private iLast As Long
  18. Private cChunk As Long
  19.  
  20. Private Sub Class_Initialize()
  21.     cChunk = 10     ' Default size can be overridden
  22.     ReDim Preserve av(1 To cChunk) As Variant
  23.     iLast = 1
  24. End Sub
  25.  
  26. ' Friend properties to make data structure accessible to walker
  27. Friend Property Get Vector(ByVal i As Long) As Variant
  28.     BugAssert i > 0 And i <= iLast
  29.     If IsObject(av(i)) Then
  30.         Set Vector = av(i)
  31.     Else
  32.         Vector = av(i)
  33.     End If
  34. End Property
  35.  
  36. ' NewEnum must have the procedure ID -4 in Procedure Attributes dialog
  37. ' Create a new data walker object and connect to it
  38. Public Function NewEnum() As IEnumVARIANT
  39. Attribute NewEnum.VB_UserMemId = -4
  40.     ' Create a new iterator object
  41.     Dim vectorwalker As CVectorWalker
  42.     Set vectorwalker = New CVectorWalker
  43.     ' Connect it with collection data
  44.     vectorwalker.Attach Me
  45.     ' Return it
  46.     Set NewEnum = vectorwalker.NewEnum
  47. End Function
  48.  
  49. ' Item is the default property
  50. Property Get Item(ByVal i As Long) As Variant
  51. Attribute Item.VB_UserMemId = 0
  52.     BugAssert i > 0
  53.     ' If index is out-of-range, return default (Empty)
  54.     On Error Resume Next
  55.     If IsObject(av(i)) Then
  56.         Set Item = av(i)
  57.     Else
  58.         Item = av(i)
  59.     End If
  60. End Property
  61.  
  62. Property Let Item(ByVal i As Long, ByVal vItemA As Variant)
  63.     BugAssert i > 0
  64.     On Error GoTo FailLetItem
  65.     av(i) = vItemA
  66.     If i > iLast Then iLast = i
  67.     Exit Property
  68. FailLetItem:
  69.     If i > UBound(av) Then
  70.         ReDim Preserve av(1 To i + cChunk) As Variant
  71.         Resume      ' Try again
  72.     End If
  73.     ErrRaise Err.Number     ' Other VB error for client
  74. End Property
  75.  
  76. Property Set Item(ByVal i As Long, ByVal vItemA As Variant)
  77.     BugAssert i > 0
  78.     On Error GoTo FailSetItem
  79.     Set av(i) = vItemA
  80.     If i > iLast Then iLast = i
  81.     Exit Property
  82. FailSetItem:
  83.     If i > UBound(av) Then
  84.         ReDim Preserve av(1 To i + cChunk) As Variant
  85.         Resume      ' Try again
  86.     End If
  87.     ErrRaise Err.Number     ' Other VB error for client
  88. End Property
  89.  
  90. Property Get Last() As Long
  91.     Last = iLast
  92. End Property
  93. Property Let Last(iLastA As Long)
  94.     BugAssert iLastA > 0
  95.     ReDim Preserve av(1 To iLastA) As Variant
  96.     iLast = iLastA
  97. End Property
  98.  
  99. Property Get Chunk() As Long
  100.     Chunk = cChunk
  101. End Property
  102. Property Let Chunk(cChunkA As Long)
  103.     BugAssert cChunkA > 0
  104.     cChunk = IIf(cChunkA < 100, cChunkA, 100)
  105. End Property
  106. '
  107.  
  108. #If fComponent = 0 Then
  109. Private Sub ErrRaise(e As Long)
  110.     Dim sText As String, sSource As String
  111.     If e > 1000 Then
  112.         sSource = App.ExeName & ".Vector"
  113.         Select Case e
  114.         Case eeBaseVector
  115.             BugAssert True
  116.        ' Case ee...
  117.        '     Add additional errors
  118.         End Select
  119.         Err.Raise COMError(e), sSource, sText
  120.     Else
  121.         ' Raise standard Visual Basic error
  122.         sSource = App.ExeName & ".VBError"
  123.         Err.Raise e, sSource
  124.     End If
  125. End Sub
  126. #End If
  127.  
  128.